1 Introducción

Este documento consiste en una revisión del proceso de validación de EPSOC 2018. Se trata de un documento reproducible y dinámico que será actualizado cada vez que haya una nueva entrega de datos durante el trabajo de campo. El código está inserto dentro del documento, pero replegado. Para verlo hacer click en cuadro code.

2 Preámbulo

Se cargan los datos en el formato entregado y se homogeneiza el formato en minúscula y usando puntos (“.”) para separar en vez de guiones bajos (“_”).

pacman::p_load(tidyverse, lubridate, anytime, chron,
               haven, sf,
               sjlabelled, sjmisc, 
               validate, eeptools, kableExtra, janitor, here, naniar,
               captioner)

if(Sys.info()[["user"]] == 'caayala'){
  path <- "/Users/caayala/Dropbox (DESUC)/DESUC/Proyectos/3 Políticas Públicas/EPSOC 2018/BD/"
} else if(Sys.info()[["user"]] == 'Andres') {
  path <- "/Users/Andres/Dropbox (DESUC)/Proyectos/3 Políticas Públicas/EPSOC 2018/BD/"
}

epsoc <-haven::read_spss(paste0(path, '190205 - EPSOC Base parcial 16.sav')) %>% 
  clean_names() %>% 
  mutate(region = folio %/% 100000,
         i_1_orden = as.integer(i_1_orden))

names(epsoc) <- tolower(gsub("_", ".", names(epsoc)))

grabacion <- FALSE

kable_estilo <- function(tabla){
  tabla %>% 
    kableExtra::kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                              full_width=F)
}

makeVlist <- function(dta) { 
        labels <- sapply(dta, function(x) attr(x, "label"))
        tibble(name = names(labels),
               label = labels)
        
}  ## Etiquetas variables
labs.epsoc <- makeVlist(epsoc)
labs.epsoc <- labs.epsoc %>% 
  mutate(label2 = map_chr(label, toString))

labs.epsoc <- get_label(epsoc)

3 General

La actual base cuenta con 818 casos recogidos entre el 2018-10-17 y el 2019-02-03.

epsoc %>% 
  count(region, status) %>% 
  spread(status, n) %>% 
  janitor::adorn_totals(where = c('row', 'col')) %>% 
  kable() %>% 
  kable_estilo()

region	Aceptado	In Progress (Other)	Requires Approval	Total
2	294	28	25	347
9	95	11	57	163
13	205	49	54	308
Total	594	88	136	818

3.1 Distribución encuestado

epsoc <- epsoc %>% 
  mutate(rango_edad = rec(edad.seleccionado,
                          rec = "1:17 =  1[menor de 18 años];
                                 18:24 = 2[18 a 24 años]; 
                                 25:44 = 3[25 a 44 años];
                                 45:59 = 4[45 a 59 años]"))

frq(epsoc, rango_edad)

## 
## # rango_edad <numeric> 
## # total N=818  valid N=815  mean=3.24  sd=0.71
##  
##  val            label frq raw.prc valid.prc cum.prc
##    1 menor de 18 años   0    0.00      0.00    0.00
##    2     18 a 24 años 133   16.26     16.32   16.32
##    3     25 a 44 años 351   42.91     43.07   59.39
##    4     45 a 59 años 331   40.46     40.61  100.00
##   NA               NA   3    0.37        NA      NA

epsoc %>% 
  filter(is.na(rango_edad)) %>%
  select(sexo.seleccionado, edad.seleccionado, situacion.laboral.seleccionado)

## # A tibble: 3 x 3
##   sexo.seleccionado edad.seleccionado situacion.laboral.seleccionado
##   <dbl+lbl>                     <dbl> <dbl+lbl>                     
## 1 NA                               NA NA                            
## 2 NA                               NA NA                            
## 3 NA                               NA NA

Probablemente discrepancia de edad para las personas mayores de 59 años se debe a una confusión entre edad reportada o fecha de cumpleaños. Podría también tratarse de casos que tenían 59 años al momento de hacerse la encuesta, pero que al momento de validar los datos ya hayan cumplido los 60 .Quedarán asignados al grupo de edad rango_edad == 4.

epsoc <- epsoc %>% 
  mutate(rango_edad = replace(rango_edad, edad.seleccionado %in% c(60, 61), 4))

epsoc %>% 
  count(sexo.seleccionado, rango_edad, situacion.laboral.seleccionado) %>% 
  mutate_all(as_label) %>% 
  mutate(prop = round(n/sum(n), 4)) %>% 
  kable() %>% 
  kable_estilo()

sexo.seleccionado	rango_edad	situacion.laboral.seleccionado	n	prop
Hombre	18 a 24 años	Trabaja	28	0.0342
Hombre	18 a 24 años	No trabaja	36	0.0440
Hombre	25 a 44 años	Trabaja	118	0.1443
Hombre	25 a 44 años	No trabaja	12	0.0147
Hombre	45 a 59 años	Trabaja	92	0.1125
Hombre	45 a 59 años	No trabaja	20	0.0244
Mujer	18 a 24 años	Trabaja	21	0.0257
Mujer	18 a 24 años	No trabaja	48	0.0587
Mujer	25 a 44 años	Trabaja	137	0.1675
Mujer	25 a 44 años	No trabaja	84	0.1027
Mujer	45 a 59 años	Trabaja	115	0.1406
Mujer	45 a 59 años	No trabaja	104	0.1271
NA	NA	NA	3	0.0037

3.2 Duración entrevistas

La distribución de la duración de las entrevistas registrada por las tablets se puede ver en la siguiente figura.

homologar_fechas <- function(fecha){
  fecha %>% 
    str_replace_all(c("^\\D{3} " = "", '(.*)(\\d{4}$)' = '\\2 \\1')) %>% 
    anytime::anytime()
}

epsoc <- epsoc %>% 
  mutate_at(vars(starts_with('time')), homologar_fechas)

epsoc <- epsoc %>% 
  mutate(duration = str_replace_all(duration, c('-' = '', '^(\\d{2})' = '0\\.\\1'))) %>% 
  separate(duration, into = c('dura.d', 'duracion'), sep = '\\.', convert = TRUE, remove = FALSE) %>% 
  mutate(duracion.t = as.duration(hms(duracion) + hms(hms::hms(hour = (24 * dura.d)))))

epsoc$duracion.t.min <- epsoc$duracion.t@.Data/60

epsoc %>% 
  ggplot(aes(x = duracion.t.min)) + 
  geom_histogram(binwidth = 5) +
  theme_bw() +
  ggtitle("Distribución duración entrevistas por región (escala truncada < 150 minutos)") +
  labs(x = "Duración total entrevista (minutos)",
       y = "Frecuencia") +
  coord_cartesian(xlim = 0:150) +
  scale_x_continuous(breaks = seq(0, 150, by = 15)) +
  facet_grid(as_factor(region) ~ .)

Existen 40 entrevistas que duran menos de 20 minutos, estas debieran ser supervisadas.

epsoc %>%
  filter(as.double(duracion.t.min) < 20) %>%
  select(folio, duracion.t.min) %>% 
  knitr::kable(col.names = c("Folio", "Duración (minutos)"),
               caption = "Entrevistas de menos de 20 minutos",
               digits = 1) %>% 
  kable_estilo() %>% 
  column_spec(1, width = "10em") %>% 
  column_spec(2, width = "10em")

Entrevistas de menos de 20 minutos
Folio	Duración (minutos)
200329	19.8
201186	18.2
201293	19.7
201350	11.4
201434	19.9
201863	16.0
201921	16.4
201947	19.1
202382	19.4
202465	19.6
202879	16.4
202895	19.3
203190	18.7
203372	18.4
204065	19.0
204396	19.5
204867	16.4
204966	18.6
205039	17.2
205443	19.4
205484	16.6
207431	16.9
207456	19.4
207464	14.2
208462	19.8
902296	17.6
902312	19.2
902940	17.9
903013	19.3
903088	20.0

Existen 43 entrevistas que duran más de 150 minutos, estas debieran ser supervisadas.

epsoc %>%
  filter(as.double(duracion.t.min) > 150) %>%
  transmute(folio, duracion.t.min / 60) %>% 
  knitr::kable(col.names = c("Folio", "Duración (horas)"),
               caption = "Entrevistas de más de 150 minutos",
               digits = 1) %>% 
  kable_estilo() %>% 
  column_spec(1, width = "10em") %>% 
  column_spec(2, width = "10em")

Entrevistas de más de 150 minutos
Folio	Duración (horas)
200444	72.8
200527	69.8
200550	4.6
200717	49.6
202135	71.9
202671	25.7
203349	3.4
205427	14.2
900183	2.6
902569	2.7
903443	235.0
903815	236.7
903922	91.3
903963	120.9
905976	14.3
1301928	18.6
1301951	192.9
1302157	4.2
1302421	96.4
1303254	25.1
1303262	25.6
1303643	24.6
1303833	4.0
1304062	23.6
1304732	24.4
1305465	23.4
1305515	72.0
1306646	2.8
1307339	218.9
1307370	50.1
1310515	22.6
1311471	5.2
1312958	50.4

3.3 Producción por día

Cantidad de encuestas realizadas por día.

## Comienzo encuesta
epsoc$time1.hms <- hms::as.hms(epsoc$time1)
epsoc$time1.wday <- lubridate::wday(epsoc$time1)
epsoc$time1.dmy <- date(epsoc$time1)

epsoc %>% 
  count(time1.dmy) %>% 
  mutate(n_mean = mean(n)) %>%  
  ggplot(aes(x = time1.dmy, y = n)) +
  geom_line() +
  geom_smooth() +
  geom_hline(aes(yintercept = n_mean), colour = 'green') +
  geom_label(aes(x = min(time1.dmy)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
  labs(title = 'Número de encuestas por día') +
  scale_x_date(breaks = '2 weeks')

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

epsoc %>% 
  count(time1.wday) %>% 
  mutate(n_mean = mean(n)) %>%  
  ggplot(aes(x = time1.wday, y = n)) +
  geom_line() +
  geom_smooth() +
  geom_hline(aes(yintercept = n_mean), colour = 'green') +
  geom_label(aes(x = min(time1.wday)[[1]], y = n_mean[[1]], label = round(n_mean, 1))) +
  labs(title = 'Número de encuestas por día de la semana') +
  scale_x_continuous(breaks = seq(7))

## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

3.4 Georeferrenciación

Existen 186 entrevistas sin datos de georreferenciación:

epsoc %>% 
  select(folio, latitude, srvyr) %>% 
  group_by(srvyr) %>% 
  mutate(n.enc = length(folio)) %>% 
  filter(is.na(latitude)) %>%
  select(folio, srvyr, n.enc) %>% 
  mutate(n.enc.sg = (length(folio)/n.enc)*100) %>%       
  arrange(srvyr, folio) %>% 
  group_by_at(vars(-folio)) %>% 
  nest() %>% 
  mutate(Folio = map_chr(data, ~ flatten(.) %>% str_c(., collapse = ', '))) %>% 
  select(-data) %>% 
  kable(digits = 1, 
        col.names = c("Encuestador", "Total encuestas", "% sin georef.", "folios")) %>% 
  kable_estilo()

Encuestador	Total encuestas	% sin georef.	folios
ageraldo.2	63	39.7	200857, 201376, 201475, 201715, 202143, 202465, 202598, 202770, 203034, 203042, 203083, 203216, 203224, 203240, 203315, 203331, 203570, 203877, 203885, 204040, 204081, 204289, 204297, 205237, 205427
atoledo.9	103	1.0	906164
cobando.9	26	23.1	903344, 903443, 903450, 903625, 903658, 906438
i.perez	23	30.4	1300433, 1301514, 1302850, 1312610, 1312636, 1312644, 1312669
j.morales	11	9.1	1305465
jossio.2	98	49.0	200253, 200493, 200691, 201038, 201053, 201186, 201293, 201392, 201491, 201590, 201749, 201863, 202192, 202226, 202242, 202267, 202382, 202481, 202796, 202879, 202895, 203059, 203067, 203075, 203141, 203190, 203489, 203588, 203752, 203760, 203794, 203844, 203851, 204396, 204644, 204867, 204966, 205039, 205062, 205484, 205658, 205682, 205872, 206144, 206177, 206763, 207233, 207266
ksakuda.2	29	48.3	201483, 201921, 202473, 202788, 203323, 203372, 203380, 204016, 207415, 207423, 207431, 207449, 207456, 207464
M.Alert	5	100.0	1305234, 1305242, 1306646, 1310515, 1311471
m.calderon	2	100.0	1310226, 1311935
mdiaz.2	83	7.2	202697, 203117, 203257, 203265, 203273, 205229
mrobles.2	58	51.7	200212, 200477, 201111, 201772, 202218, 202234, 202275, 202572, 204339, 204818, 204875, 205013, 205047, 205450, 205468, 205666, 205690, 205864, 205948, 205963, 206110, 206151, 206318, 206623, 206631, 206714, 207647, 207712, 207936, 208314
ncaceres.2	1	100.0	205930
nicol.alarcon	3	100.0	1310119, 1310143, 1310150
p.aguilera	4	75.0	1300912, 1300953, 1303726
p.gajardo	6	33.3	1303510, 1303528
p.vegazo	96	6.2	1300870, 1303825, 1304542, 1309129, 1309160, 1309178
rfigueroa.9	8	100.0	901918, 901926, 902023, 902056, 902072, 905919, 905943, 905950
s.gonzalez	16	75.0	1301910, 1301928, 1301936, 1301944, 1301951, 1301969, 1302066, 1303916, 1303940, 1303965, 1305911, 1307057
v.becerra	2	100.0	1300672, 1300698
v.sierra	55	3.6	1306679, 1306695
ycifuente.9	4	50.0	901314, 901322

3.5 Puntos de encuestas

epsoc_geo <- epsoc %>% 
  select(folio, sbj.num, region, srvyr, longitude, latitude) %>% 
  filter(!is.na(latitude)) %>% 
  sf::st_as_sf(coords = c('longitude', 'latitude'),
               crs = "+proj=longlat +ellps=GRS80")

sf::write_sf(epsoc_geo,
             here::here('validacion_epsoc_puntos_respuesta.kml'),
             dataset_options=c("NameField=folio"),
             delete_dsn=TRUE)

3.5.1 Antofagasta

epsoc_geo %>% 
  filter(region == 2) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf()

3.5.2 Temuco

epsoc_geo %>% 
  filter(region == 9) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf()

3.5.3 Santiago

epsoc_geo %>% 
  filter(region == 13) %>% 
  ggplot(aes(color = srvyr)) +
  geom_sf()

4 Experimentos

EPSOC contiene dos experimentos que constituyen un foco de análisis del instrumento. El primer experimento consiste en un diseño factorial a través viñetas. El segundo se trata de una aleatorización del orden de preguntas sobre recompensa percibida y justa para tres objetos de evaluación: un obrero, un presidente de empresa y el respondente. Actualmente no es posible validar estos experimento por falta de información.

4.1 Viñetas

Para validar el proceso con las viñetas necesitamos:

Una breve explicación de cómo está codificado el experimento de las viñetas en la base de datos
La base de datos que asocia los folios con sets de viñeta en orden presentado
Acceso a grabaciones de voz durante el proceso de entrevista para asegurarnos que están bien asociadas las escalas con las variables

4.1.1 Distribución de viñetas

Revisar la distribución efectiva captada de los decks de viñetas en terreno hasta el momento.

epsoc %>% 
  select(folio, i.1.grupo) %>% 
  head()

## # A tibble: 6 x 2
##    folio i.1.grupo
##    <dbl> <chr>    
## 1 200139 23       
## 2 200147 17       
## 3 200162 11       
## 4 200212 15       
## 5 200220 15       
## 6 200238 31

epsoc %>% 
  transmute(i.1.grupo = as.integer(i.1.grupo),
            region) %>% 
  group_by_all() %>% 
  count() %>% 
  group_by(region) %>% 
  mutate(n_mean = mean(n)) %>% 
  ggplot(aes(x = as_factor(i.1.grupo), y = n)) +
  geom_col() +
  geom_hline(aes(group = region, yintercept = n_mean), colour = 'green') + 
  geom_text(aes(label = ..y..), nudge_y = 1, size = 3) +
  facet_grid(rows = vars(region)) +
  labs(title = 'Distribución de viñetas')

4.1.2 Duración ejercicio

Los marcadores de tiempo time2 y time3 no siguen un formato homogéneo para registrar la hora. Por ejemplo, en algún caso se utiliza el formato “2018-10-27T19:05:08-03:00” y en otros “Fri Oct 19 13:01:59 -0300 2018”
Homogeneizar formatos de tiempos y fechas a ISO8601

## Comienzo viñetas
epsoc$time2.hms <- hms::as.hms(epsoc$time2)
epsoc$time2.dmy <- date(epsoc$time2)

## Fin viñetas
epsoc$time3.hms <- hms::as.hms(epsoc$time3)
epsoc$time3.dmy <- date(epsoc$time3)

epsoc$dura.vinetas <- difftime(epsoc$time3, epsoc$time2,
                               units = "mins")

ggplot(epsoc, aes(x = time2.dmy, y = time2.hms)) + 
  geom_point(alpha = 0.6) +
  labs(x = "Día", y = "Hora") + 
  ggtitle("Día y hora comienzo actividad viñetas") + 
  theme_bw()

ggplot(epsoc, aes(x = srvyr, y = time2.hms)) + 
  geom_point(alpha = 0.6) +
  labs(x = "Encuestador", y = "Hora") + 
  ggtitle("Hora comienzo actividad viñetas según encuestador") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))

epsoc %>% 
  mutate(vin.cort = ifelse(dura.vinetas < 5, "< 5'", ">= 5'")) %>% 
  ggplot(aes(dura.vinetas)) + 
  geom_histogram(aes(fill = vin.cort)) + theme_bw() +
  theme(legend.title=element_blank()) +
  ggtitle("Duración ejercicio viñetas") +
  xlab("Minutos")

Como se puede ver en la figura anterior, la distribución del tiempo de duración del ejercicio de viñetas es variable. En términos de validación, llama la atención que se logre realizar el ejercicio en menos de cinco minutos. Estos casos deberían ser revisados apenas sea posible.

ggplot(epsoc, aes(x = srvyr, y = if_else(dura.vinetas < 60, dura.vinetas, 60), 
                  colour = status)) + 
  geom_point(alpha = 0.5,
             position = position_jitter(width = .2)) +
  scale_color_manual(values = c('green', 'orange', 'blue')) + 
  facet_grid(cols = vars(region), scales = 'free_x', space = 'free_x') +
  labs(x = "Encuestador", y = "minutos") + 
  ggtitle("Duración de actividad viñetas según encuestador según región") + 
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 1))

## Don't know how to automatically pick scale for object of type difftime. Defaulting to continuous.

En particular, deben supervisarse las siguientes entrevistas donde el ejercicio duró menos de 5 minutos:

kable(epsoc %>% 
        group_by(srvyr) %>% 
        mutate(n.enc = length(folio)) %>% 
        select(folio, dura.vinetas, srvyr, n.enc) %>% 
        filter(dura.vinetas <= 5) %>%
        mutate(n.enc.cort = (length(folio)/n.enc)*100) %>% 
        arrange(srvyr, dura.vinetas), 
      digits = 1,
      col.names = c("Folio", "Duración viñetas", "Encuestador", "Total encuestas", "% cortas"),
      caption = "Ejercicio viñetas de menos de 5 minutos") %>% 
  kable_estilo() #%>%

Ejercicio viñetas de menos de 5 minutos
Folio	Duración viñetas	Encuestador	Total encuestas	% cortas
205427	2.6 mins	ageraldo.2	63	3.2
202465	5.0 mins	ageraldo.2	63	3.2
902296	4.4 mins	atoledo.9	103	1.0
902254	4.1 mins	cobando.9	26	3.8
204966	4.3 mins	jossio.2	98	3.1
204396	4.6 mins	jossio.2	98	3.1
201186	4.7 mins	jossio.2	98	3.1
1310119	3.2 mins	nicol.alarcon	3	33.3
905943	4.9 mins	rfigueroa.9	8	12.5

#column_spec(1, width = "10em") %>% 
#column_spec(2, width = "10em") %>% 
#column_spec(3, width = "10em")

4.1.3 Reconstrucción de variables de outcome

labels_correcion <- function(.vect) {
  replace(.vect, .vect == 6, -1) %>% 
    remove_labels(labels = '- 1') %>% 
    add_labels(labels = c('- 1' = -1))
}

gg_ideologia_orden <- function(.data, var_orden, miss = 88){
  var_orden_quo <- enquo(var_orden)
  
  .data %>% 
    gather('variable', 'valor', -!!var_orden_quo) %>% 
    filter(valor < miss) %>%
    ggplot(aes(x = valor)) +
    geom_bar() +
    facet_grid(rows = vars(variable),
               cols = vars(!!var_orden_quo))
}

4.1.3.1 Ideología para ego y alter

ideologia_ego <- list(orden1 = c("c0.1", "c1.1.1", "c1.2.1", "c1.3.1", "c1.4.1", "c2.1.1", "c2.2.1", "c2.3.1", "c2.4.1"),
                      orden2 = c("c0.2", "c1.4.2", "c1.1.2", "c1.2.2", "c1.3.2", "c2.4.2", "c2.1.2", "c2.2.2", "c2.3.2"),
                      orden3 = c("c0.3", "c1.3.3", "c1.4.3", "c1.1.3", "c1.2.3", "c2.3.3", "c2.4.3", "c2.1.3", "c2.2.3"), 
                      orden4 = c("c0.4", "c1.2.4", "c1.3.4", "c1.4.4", "c1.1.4", "c2.2.4", "c2.3.4", "c2.4.4", "c2.1.4"))

df_ideologia_ego <- epsoc %>% 
  select(folio, i.1.orden, !!!flatten_chr(ideologia_ego)) %>% 
  nest(-i.1.orden) %>% 
  arrange(i.1.orden)

df_ideologia_ego <- df_ideologia_ego %>% 
  mutate(orden = ideologia_ego[str_glue("orden{i.1.orden + 1}")],
         data = map2(data, orden, ~select(.x, one_of("folio", .y))),
         data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))

df_ideologia_ego

## # A tibble: 4 x 4
##   i.1.orden data          orden   data_var                                 
##       <int> <list>        <list>  <chr>                                    
## 1         0 <tibble [191… <chr [… folio, c0.1, c1.1.1, c1.2.1, c1.3.1, c1.…
## 2         1 <tibble [206… <chr [… folio, c0.2, c1.4.2, c1.1.2, c1.2.2, c1.…
## 3         2 <tibble [208… <chr [… folio, c0.3, c1.3.3, c1.4.3, c1.1.3, c1.…
## 4         3 <tibble [213… <chr [… folio, c0.4, c1.2.4, c1.3.4, c1.4.4, c1.…

map_dfc(df_ideologia_ego$data, get_label) %>% 
  mutate_all(str_trunc, width = 25)

## # A tibble: 10 x 4
##    V1                 V2                V3                V4               
##    <chr>              <chr>             <chr>             <chr>            
##  1 ""                 ""                ""                ""               
##  2 Observe esta esca… Observe esta esc… Observe esta esc… Observe esta esc…
##  3 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
##  4 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
##  5 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
##  6 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…
##  7 "Escala \"Las fam… "Escala \"Las fa… "Escala \"Las fa… "Escala \"Las fa…
##  8 "Escala \"Chile n… "Escala \"Chile … "Escala \"Chile … "Escala \"Chile …
##  9 "Escala \"Educaci… "Escala \"Educac… "Escala \"Educac… "Escala \"Educac…
## 10 "Escala \"Más con… "Escala \"Más co… "Escala \"Más co… "Escala \"Más co…

suppressWarnings(
  df_ideologia_ego <- df_ideologia_ego %>% 
    mutate(data = map(data, ~rename_all(.x, ~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))) %>% 
    select(data) %>% 
    unnest()
)

df_ideologia_ego <- copy_labels(df_new = df_ideologia_ego,
                                df_origin = epsoc %>% 
                                  select(one_of(c('folio', ideologia_ego$orden1))) %>% 
                                  rename_all(~c("folio", str_remove(ideologia_ego$orden1,'.\\d{1,2}$'))))

Agregar variables reconstruidas a base de datos.

epsoc <- left_join(epsoc, 
                   df_ideologia_ego,
                   by = 'folio')

## Warning: Column `folio` has different attributes on LHS and RHS of join

epsoc %>% 
  select(i.1.orden, matches("c[1-2].\\d{1}$")) %>% 
  gather('variable', 'valor', -i.1.orden) %>% 
  mutate(referencia = if_else(str_detect(variable, 'c1.*'), 'ego', 'alter'),
         outcome = str_extract(variable, '(\\d*)$')) %>% 
  filter(valor < 88) %>% 
  ggplot(aes(x = valor, fill = fct_rev(referencia))) +
  geom_bar(position = position_dodge()) +
  facet_grid(rows = vars(outcome),
             cols = vars(i.1.orden)) +
  labs(title = 'Distribución de viñetas ego y alter, según orden de preguntas') +
  scale_fill_discrete(name = 'Referencia')

## Warning: attributes are not identical across measure variables;
## they will be dropped

4.1.3.2 Ideología para viñetas

Primero es necesario reunir las variables

ideologia_vin <- list(orden1 = c(1, 2, 3, 4),
                      orden2 = c(4, 1, 2, 3),
                      orden3 = c(3, 4, 1, 2), 
                      orden4 = c(2, 3, 4, 1))

df_ideologia_vin <- epsoc %>% 
  select(folio, i.1.orden, matches("^c([3-9]|10)\\.[1-4].*")) %>% 
  nest(-i.1.orden) %>% 
  arrange(i.1.orden)

ideologia_variables <- function(persona, orden, grupo){
  expand.grid(persona, orden, grupo) %>% 
  arrange(Var1) %>% 
  str_glue_data("c{Var1}.{Var2}.{Var3}")
}

df_ideologia_vin <- df_ideologia_vin %>% 
  mutate(orden = ideologia_vin[str_glue("orden{i.1.orden + 1}")],
         variables = map2(orden, i.1.orden + 1, ~ideologia_variables(3:10, .x, .y)),
         data = map2(data, variables, ~select(.x, one_of("folio", .y))),
         data_var = map(data, names) %>% map_chr(str_c, collapse = ', '))

df_ideologia_vin %>% 
  select(i.1.orden, data_var)

## # A tibble: 4 x 2
##   i.1.orden data_var                                                       
##       <int> <chr>                                                          
## 1         0 folio, c3.1.1, c3.2.1, c3.3.1, c3.4.1, c4.1.1, c4.2.1, c4.3.1,…
## 2         1 folio, c3.4.2, c3.1.2, c3.2.2, c3.3.2, c4.4.2, c4.1.2, c4.2.2,…
## 3         2 folio, c3.3.3, c3.4.3, c3.1.3, c3.2.3, c4.3.3, c4.4.3, c4.1.3,…
## 4         3 folio, c3.2.4, c3.3.4, c3.4.4, c3.1.4, c4.2.4, c4.3.4, c4.4.4,…

etiquetas <- map(df_ideologia_vin$data, get_labels)

ideologia_vin1_names <- names(df_ideologia_vin$data[[1]])
ideologia_vin1_gen_names <- str_remove(ideologia_vin1_names, '.\\d{1,2}$')

suppressWarnings(
  df_ideologia_vin <- df_ideologia_vin %>% 
    mutate(data = map(data, ~rename_all(.x, ~ideologia_vin1_gen_names))) %>% 
    select(data) %>% 
    unnest()
)

df_ideologia_vin <- copy_labels(df_new = df_ideologia_vin,
                                df_origin = epsoc %>% 
                                  select(!!!ideologia_vin1_names) %>% 
                                  rename_all(~ideologia_vin1_gen_names))

head(df_ideologia_vin)

## # A tibble: 6 x 33
##    folio  c3.1  c3.2  c3.3  c3.4  c4.1  c4.2  c4.3  c4.4  c5.1  c5.2  c5.3
##    <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 200162     1     1    11     1     1     1    11     1    11     1     1
## 2 200238    11    10     1     2     2     1    11    11     3     3    10
## 3 200246    11     1    11     1     1    11    11    11    11     1     1
## 4 200329     4    11    10     3     4     9     3     3     8     3    10
## 5 200337     2     2     1     1     6    10     1     1     1     9     3
## 6 200410     1     1     1     1    11    11     1     1    11    11     1
## # … with 21 more variables: c5.4 <dbl>, c6.1 <dbl>, c6.2 <dbl>,
## #   c6.3 <dbl>, c6.4 <dbl>, c7.1 <dbl>, c7.2 <dbl>, c7.3 <dbl>,
## #   c7.4 <dbl>, c8.1 <dbl>, c8.2 <dbl>, c8.3 <dbl>, c8.4 <dbl>,
## #   c9.1 <dbl>, c9.2 <dbl>, c9.3 <dbl>, c9.4 <dbl>, c10.1 <dbl>,
## #   c10.2 <dbl>, c10.3 <dbl>, c10.4 <dbl>

Agregar variables reconstruidas a base de datos.

epsoc <- left_join(epsoc, 
                   df_ideologia_vin,
                   by = 'folio')

## Warning: Column `folio` has different attributes on LHS and RHS of join

Gráficos para comparar distribuciones entre viñetas y orden

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).1$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Familias, según orden de preguntas')

## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).2$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Orden o Cambio, según orden de preguntas')

## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).3$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Educación, según orden de preguntas')

## Warning: attributes are not identical across measure variables;
## they will be dropped

epsoc %>% 
  select(i.1.orden, matches('c([3-9]|10).4$')) %>% 
  gg_ideologia_orden(i.1.orden) +
  labs(title = 'Distribución de viñetas Grandes Empresas, según orden de preguntas')

## Warning: attributes are not identical across measure variables;
## they will be dropped

4.2 Recompensa justa

Para validar el experimento de evaluación de justicia necesitamos: - Una breve explicación de cómo están codificados los items de recompensa percibida y recompensa justa para un obrero, el presidente de una empresa y el respondente - Es fundamental saber cuál es la variable que define el orden en que se presentó una y otra pregunta

4.2.1 Distribución de tratamientos

La variable a que determina el tratamiento mostrado en la encuesta es la variable num.grupo.jd.

flat_table(epsoc, num.grupo.jd, region, margin = 'col')

##              region     2     9    13
## num.grupo.jd                         
## 0                   26.80 23.31 22.73
## 1                   23.63 27.61 25.32
## 2                   27.95 21.47 26.62
## 3                   21.61 27.61 25.32

4.2.2 Variables asociadas

Existen 24 variables asociadas al experimiento de recompensa justa que se detallan a continuación:

var_rec_justa <- find_var(epsoc, pattern = stringr::regex('obrero|pdte'), search = 'label')

var_rec_justa$var.label %>% 
  str_replace_all(c('Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos u ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos' = 'cuánto dinero cree Ud. que ganan',
                    'Pensando en lo que Ud. cree que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos. ' = '')) %>% 
   paste0(var_rec_justa$var.name, " - ", sort(rep(seq(6), 4)), " - ", .)

##  [1] "i.1.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
##  [2] "i.2.g1a.1.rec - 1 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
##  [3] "i.1.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
##  [4] "i.2.g2a.1.rec - 1 - ¿Cuál sería una remuneración justa para (obrero)?"                                                                                                                                                                                                       
##  [5] "i.1.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
##  [6] "i.2.g2a.2.rec - 2 - ¿Cuál sería una remuneración justa para (obrero)?"                                                                                                                                                                                                       
##  [7] "i.1.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
##  [8] "i.2.g1a.2.rec - 2 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
##  [9] "i.1.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
## [10] "i.2.g1a.3.rec - 3 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
## [11] "i.1.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
## [12] "i.2.g2b.3.rec - 3 - ¿Cuál sería una remuneración justa para (obrero)?"                                                                                                                                                                                                       
## [13] "i.1.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
## [14] "i.2.g1b.4.rec - 4 - ¿Cuál sería una remuneración justa para (obrero)?"                                                                                                                                                                                                       
## [15] "i.1.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
## [16] "i.2.g1a.4.rec - 4 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
## [17] "i.1.g1a.3.2 - 5 - (un obrero no calificado de una fábrica) Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos/ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos (i"
## [18] "i.1.g1b.3.2 - 5 - (un obrero no calificado de una fábrica) Pensando en lo que Ud. cree que sería justo que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos (ingreso líquido).  ¿Cuál sería una remu"   
## [19] "i.1.g2b.4.2 - 5 - (un obrero no calificado de una fábrica) Pensando en lo que Ud. cree que sería justo que las personas en estos trabajos deberían ganar al mes, después de los descuentos de salud, previsión u otros impuestos (ingreso líquido).  ¿Cuál sería una remu"   
## [20] "i.1.g2a.4.2 - 5 - (un obrero no calificado de una fábrica) Quisiéramos saber cuánto dinero cree Ud. que ganan las personas al mes en estos trabajos/ocupaciones que se mencionan más adelante, después de considerar los descuentos de salud, previsión u otros impuestos (i"
## [21] "i.1.g1a.1.rec - 6 - cuánto dinero cree Ud. que ganan (pdte empresa)"                                                                                                                                                                                                         
## [22] "i.2.g1a.1.rec - 6 - cuánto dinero cree Ud. que ganan (obrero)"                                                                                                                                                                                                               
## [23] "i.1.g2a.1.rec - 6 - ¿Cuál sería una remuneración justa para (pdte empresa)?"                                                                                                                                                                                                 
## [24] "i.2.g2a.1.rec - 6 - ¿Cuál sería una remuneración justa para (obrero)?"

Al inicio de la aplicación del cuestionario se implementó 4 grupos (del grupo 1 al 4 o variables i.1.g1a.1.rec a i.2.g1a.4.rec). Como puede verse el grupo 3 es identico al 1 y el grupo 4 es igual al 2 porque se mantuvo el orden de presidente empresa y luego obrero.

Para solucionarlo, se agregaron los grupos 5 y 6 en donde se se cambia el orden a obrero y luego presidente empresa. Con esto los 4 grupos (1, 2, 5 y 6) a los que cada persona se verá confrontada serán diferentes. Como se puede ver en el gráfico , la implementación del cambio se efectuó correctamente.

epsoc %>% 
  arrange(num.grupo.jd, time1) %>% 
  select(one_of(var_rec_justa$var.name)) %>% 
  naniar::vis_miss() +
  labs(title = 'Distribución de respuestas en preguntas de recompensa justa') +
  theme(axis.text.x = element_text(angle = 90, vjust = .5, hjust = 0))

4.3 Items justicia

La encuesta considera una serie de preguntas con escalas predefinidas. A continuación se revisa que los ítems sobre justicia tengan respuestas en el rango de 1 a 5 o bien valores de 8 o 9.

item_just <- find_var(epsoc, "usto")
item_just$var.name

##  [1] "i.6.a1"      "i.8.a1"      "i.9.a1"      "i.10.a1"     "i.11.a1"    
##  [6] "i.12.a1"     "i.13.a1"     "i.16.a1"     "i.1.g1b.3.2" "i.2.g1b.3.2"
## [11] "i.1.g2b.4.2" "i.2.g2b.4.2" "i.1.h1"      "i.2.h1"      "i.5.h1"     
## [16] "i.7.h1"      "i.8.h1"      "i.10.h1"     "i.11.h1"     "i.12.h1"    
## [21] "i.14.h1"

v <- validator(j := var_group(i.6.a1, i.8.a1, i.9.a1, i.10.a1, i.11.a1, i.12.a1, i.13.a1, i.16.a1, 
                              i.1.h1, i.2.h1, i.5.h1, i.7.h1, i.8.h1, i.10.h1, i.11.h1, i.12.h1, i.14.h1), 
               j >= 1,
               j <= 9,
               j != 6,
               j != 7)

cf2 <- confront(epsoc, v)
s.cf2 <- summary(cf2)

knitr::kable(s.cf2) %>% 
  kable_estilo()

name	items	passes	error	warning	expression
V2.1	818	818	FALSE	FALSE	(i.6.a1 - 1) >= -1e-08
V2.2	818	818	FALSE	FALSE	(i.8.a1 - 1) >= -1e-08
V2.3	818	818	FALSE	FALSE	(i.9.a1 - 1) >= -1e-08
V2.4	818	818	FALSE	FALSE	(i.10.a1 - 1) >= -1e-08
V2.5	818	818	FALSE	FALSE	(i.11.a1 - 1) >= -1e-08
V2.6	818	818	FALSE	FALSE	(i.12.a1 - 1) >= -1e-08
V2.7	818	818	FALSE	FALSE	(i.13.a1 - 1) >= -1e-08
V2.8	818	818	FALSE	FALSE	(i.16.a1 - 1) >= -1e-08
V2.9	818	818	FALSE	FALSE	(i.1.h1 - 1) >= -1e-08
V2.10	818	818	FALSE	FALSE	(i.2.h1 - 1) >= -1e-08
V2.11	818	818	FALSE	FALSE	(i.5.h1 - 1) >= -1e-08
V2.12	818	818	FALSE	FALSE	(i.7.h1 - 1) >= -1e-08
V2.13	818	818	FALSE	FALSE	(i.8.h1 - 1) >= -1e-08
V2.14	818	818	FALSE	FALSE	(i.10.h1 - 1) >= -1e-08
V2.15	818	818	FALSE	FALSE	(i.11.h1 - 1) >= -1e-08
V2.16	818	818	FALSE	FALSE	(i.12.h1 - 1) >= -1e-08
V2.17	818	818	FALSE	FALSE	(i.14.h1 - 1) >= -1e-08
V3.1	818	818	FALSE	FALSE	(i.6.a1 - 9) <= 1e-08
V3.2	818	818	FALSE	FALSE	(i.8.a1 - 9) <= 1e-08
V3.3	818	818	FALSE	FALSE	(i.9.a1 - 9) <= 1e-08
V3.4	818	818	FALSE	FALSE	(i.10.a1 - 9) <= 1e-08
V3.5	818	818	FALSE	FALSE	(i.11.a1 - 9) <= 1e-08
V3.6	818	818	FALSE	FALSE	(i.12.a1 - 9) <= 1e-08
V3.7	818	818	FALSE	FALSE	(i.13.a1 - 9) <= 1e-08
V3.8	818	818	FALSE	FALSE	(i.16.a1 - 9) <= 1e-08
V3.9	818	818	FALSE	FALSE	(i.1.h1 - 9) <= 1e-08
V3.10	818	818	FALSE	FALSE	(i.2.h1 - 9) <= 1e-08
V3.11	818	818	FALSE	FALSE	(i.5.h1 - 9) <= 1e-08
V3.12	818	818	FALSE	FALSE	(i.7.h1 - 9) <= 1e-08
V3.13	818	818	FALSE	FALSE	(i.8.h1 - 9) <= 1e-08
V3.14	818	818	FALSE	FALSE	(i.10.h1 - 9) <= 1e-08
V3.15	818	818	FALSE	FALSE	(i.11.h1 - 9) <= 1e-08
V3.16	818	818	FALSE	FALSE	(i.12.h1 - 9) <= 1e-08
V3.17	818	818	FALSE	FALSE	(i.14.h1 - 9) <= 1e-08
V4.1	818	818	FALSE	FALSE	i.6.a1 != 6
V4.2	818	818	FALSE	FALSE	i.8.a1 != 6
V4.3	818	818	FALSE	FALSE	i.9.a1 != 6
V4.4	818	818	FALSE	FALSE	i.10.a1 != 6
V4.5	818	818	FALSE	FALSE	i.11.a1 != 6
V4.6	818	818	FALSE	FALSE	i.12.a1 != 6
V4.7	818	818	FALSE	FALSE	i.13.a1 != 6
V4.8	818	818	FALSE	FALSE	i.16.a1 != 6
V4.9	818	818	FALSE	FALSE	i.1.h1 != 6
V4.10	818	818	FALSE	FALSE	i.2.h1 != 6
V4.11	818	818	FALSE	FALSE	i.5.h1 != 6
V4.12	818	818	FALSE	FALSE	i.7.h1 != 6
V4.13	818	818	FALSE	FALSE	i.8.h1 != 6
V4.14	818	818	FALSE	FALSE	i.10.h1 != 6
V4.15	818	818	FALSE	FALSE	i.11.h1 != 6
V4.16	818	818	FALSE	FALSE	i.12.h1 != 6
V4.17	818	818	FALSE	FALSE	i.14.h1 != 6
V5.1	818	818	FALSE	FALSE	i.6.a1 != 7
V5.2	818	818	FALSE	FALSE	i.8.a1 != 7
V5.3	818	818	FALSE	FALSE	i.9.a1 != 7
V5.4	818	818	FALSE	FALSE	i.10.a1 != 7
V5.5	818	818	FALSE	FALSE	i.11.a1 != 7
V5.6	818	818	FALSE	FALSE	i.12.a1 != 7
V5.7	818	818	FALSE	FALSE	i.13.a1 != 7
V5.8	818	818	FALSE	FALSE	i.16.a1 != 7
V5.9	818	818	FALSE	FALSE	i.1.h1 != 7
V5.10	818	818	FALSE	FALSE	i.2.h1 != 7
V5.11	818	818	FALSE	FALSE	i.5.h1 != 7
V5.12	818	818	FALSE	FALSE	i.7.h1 != 7
V5.13	818	818	FALSE	FALSE	i.8.h1 != 7
V5.14	818	818	FALSE	FALSE	i.10.h1 != 7
V5.15	818	818	FALSE	FALSE	i.11.h1 != 7
V5.16	818	818	FALSE	FALSE	i.12.h1 != 7
V5.17	818	818	FALSE	FALSE	i.14.h1 != 7

Existen 0 variables de actitudes sobre justicia fuera de rango.

5 Otros criterios generales

Para validar los datos consideramos los siguientes criterios:

El rango etario de la población (18 a 59 años)
Una duración de menos de dos horas
Una duración de más de quince minutos
Las variables con información redundante deben converger (edad y sexo)
Número de hijos

epsoc$duration <- chron(times=epsoc$duration)

## Warning in convert.times(times., fmt): NAs introduced by coercion

## Warning in convert.times(times., fmt): time-of-day entries out of range in
## positions NA,NA,NA,NA,NA,NA,NA,NA,NA,NA set to NA

cf <- check_that(epsoc, edad.seleccionado <= 59 & edad.seleccionado >= 18,
                 sexo.enc == sexo.seleccionado)
s.cf <- summary(cf)
knitr::kable(s.cf) %>% 
        kable_estilo()

name	items	passes	fails	nNA	error	warning	expression
V1	818	815	0	3	FALSE	FALSE	edad.seleccionado <= 59 & edad.seleccionado >= 18
V2	818	804	11	3	FALSE	FALSE	abs(sexo.enc - sexo.seleccionado) < 1e-08

Resultados:

No existen respondentes fuera del rango etario.
Existen 11 divergencias respecto al sexo del encuestado al comparar la variable sexo.enc y sexo.seleccionado.

5.1 Edad

## Fecha de nacimiento y edad seleccionado
epsoc$enc.edad[as.character(epsoc$enc.edad) == "1582-10-14"] <- NA # comportamiento extraño al importar desde SPSS
edad <- tibble(Folio = epsoc$folio[is.na(epsoc$enc.edad)],
               Fecha = epsoc$enc.edad[is.na(epsoc$enc.edad)],
               Edad = epsoc$edad.seleccionado[is.na(epsoc$enc.edad)]) 
knitr::kable(edad,
             caption = "Casos sin fecha de nacimiento en `enc_edad`",
             col.names = c("Folio", "Fecha nacimiento", "Edad")) %>% 
  kable_estilo()

Casos sin fecha de nacimiento en `enc_edad`
Folio	Fecha nacimiento	Edad
201350	NA	56
201467	NA	59
202457	NA	18
202580	NA	59
203182	NA	39
203273	NA	59
203315	NA	52
205237	NA	59
900134	NA	59
900753	NA	53
900779	NA	59
901918	NA	25
902320	NA	59
902338	NA	56
902361	NA	59
902379	NA	59
902510	NA	59
902924	NA	59
905422	NA	59
905448	NA	59
905471	NA	51
905877	NA	20
905976	NA	59
1302538	NA	47
1303577	NA	39
1309913	NA	49
1310119	NA	39
1310143	NA	26
1310150	NA	55
1311935	NA	24
1312438	NA	48

5.2 Sexo

epsoc %>% 
  filter(sexo.enc != sexo.seleccionado) %>% 
  select(Folio = folio, sexo.enc, sexo.seleccionado) %>% 
  knitr::kable(col.names = c("Folio", "sexo.enc", "sexo.seleccionado"),
               caption = "Entrevistas donde sexo encuestado y seleccionado no coinciden") %>% 
  kable_estilo()

Entrevistas donde sexo encuestado y seleccionado no coinciden
Folio	sexo.enc	sexo.seleccionado
200444	1	2
201483	1	2
205237	2	1
902213	1	2
1301928	2	1
1301936	2	1
1301944	2	1
1301969	1	2
1305911	2	1
1307131	2	1
1309913	1	2

5.3 Número de hijos

frq(epsoc$f22)

## 
## # ¿Tiene usted hijos o hijas? ¿Cuántos/as? (x) <numeric> 
## # total N=818  valid N=818  mean=2.69  sd=1.49
##  
##  val                 label frq raw.prc valid.prc cum.prc
##    1           No, ninguno 221   27.02     27.02   27.02
##    2                 Uno/a 174   21.27     21.27   48.29
##    3                   Dos 198   24.21     24.21   72.49
##    4                  Tres 140   17.11     17.11   89.61
##    5                Cuatro  54    6.60      6.60   96.21
##    6                 Cinco  12    1.47      1.47   97.68
##    7            Seis o más  16    1.96      1.96   99.63
##    8     No sabe [No leer]   0    0.00      0.00   99.63
##    9 No responde [No leer]   3    0.37      0.37  100.00
##   NA                    NA   0    0.00        NA      NA

hijos <- epsoc %>%
  select(folio, f22:f26.o5) %>%
  mutate(hijo_n       = ifelse(f22 <= 7, f22 - 1, NA),
         hijo_estudia = ifelse(f23 <= 7, f23 - 1, NA),
         hijo_egreso  = ifelse(f25 <= 7, f25 - 1, NA),
         hijo_suma    = hijo_estudia + hijo_egreso) %>%
  filter(hijo_n < hijo_suma)

hijos %>% 
  select(folio, starts_with('hijo')) %>% 
  arrange(desc(abs(hijo_n - hijo_suma)))

## # A tibble: 16 x 5
##      folio hijo_n hijo_estudia hijo_egreso hijo_suma
##      <dbl>  <dbl>        <dbl>       <dbl>     <dbl>
##  1  200212      4            4           4         8
##  2  207449      4            4           4         8
##  3  203091      6            4           5         9
##  4  203380      2            2           2         4
##  5 1307057      3            3           2         5
##  6  200139      6            4           3         7
##  7  201541      1            1           1         2
##  8  201665      3            2           2         4
##  9  201715      1            2           0         2
## 10  202465      6            1           6         7
## 11  202572      3            4           0         4
## 12  207456      6            5           2         7
## 13  902221      1            1           1         2
## 14 1301753      2            2           1         3
## 15 1302066      3            3           1         4
## 16 1304765      2            2           1         3

6 Grabaciones

Grabar base de datos con variables de viñetas reconstruidas.

epsoc %>% 
  mutate_if(is.numeric, as_labelled) %>% 
  haven::write_sav("../EPSOC Base parcial con vinetas.sav")

Obtención de archivos de grabaciones de cada encuesta.

 path_general <- '../SurveyToGo Attachments/EPSOC 2018/'

 archivos <- dir(path = path_general, 
     pattern = str_c(epsoc$sbj.num, collapse = '|'),
     recursive = TRUE)
 
 file.copy(from = str_c(path_general, archivos), 
           to = "grabaciones/",
           overwrite = TRUE)

Validación EPSOC

Equipo EPSOC

05 February, 2019